home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue31 / survive / Scanner.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-01-29  |  4.2 KB  |  179 lines
  1. unit Scanner;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes, DB, DBTables;
  7.  
  8. const
  9.   MaxBufferSize = 1024;
  10.  
  11. type
  12.   TMemoScanner = class(TBLOBStream)
  13.   private
  14.     Buffer: array[1..MaxBufferSize] of Char;
  15.     Punctuation: string;
  16.     WhiteSpace: string;
  17.     DiscardWords: TStringList;
  18.   protected
  19.     FKeywords: TStringList;
  20.     procedure DefineDiscardWords(aList: TStrings); virtual;
  21.     function DefinePunctuation: string; virtual;
  22.     function DefineWhitespace: string; virtual;
  23.     function GetKeyword(aIndex: Integer): string;
  24.     function GetKeywordCount: Integer;
  25.     procedure KeywordFound(aKeyword: string; aWordOffset: Integer); virtual;
  26.   public
  27.     constructor Create(aField: TBLOBField);
  28.     destructor Destroy; override;
  29.     procedure Scan;
  30.     property KeywordCount: Integer read GetKeywordCount;
  31.     property Keywords[aIndex: Integer]: string read GetKeyword;
  32.   end;
  33.  
  34.   TMemoScannerExt = class(TMemoScanner)
  35.   protected
  36.     procedure DefineDiscardWords(aList: TStrings); override;
  37.     function GetWordOffset(aIndex: Integer): Integer;
  38.     procedure KeywordFound(aKeyword: string; aWordOffset: Integer); override;
  39.   public
  40.     constructor Create(aField: TBLOBField);
  41.     property WordOffset[aIndex: Integer]: Integer read GetWordOffset;
  42.   end;
  43.  
  44. implementation
  45.  
  46. { TMemoScanner }
  47.  
  48. constructor TMemoScanner.Create(aField: TBLOBField);
  49. begin
  50.   inherited Create(aField, bmRead);
  51.   FKeywords := TStringList.Create;
  52.   FKeywords.Sorted := True;
  53.   FKeywords.Duplicates := dupIgnore;
  54.  
  55.   DiscardWords := TStringList.Create;
  56.   DiscardWords.Sorted := True;
  57.   DiscardWords.Duplicates := dupIgnore;
  58.   DefineDiscardWords(DiscardWords);
  59.   Punctuation := DefinePunctuation;
  60.   WhiteSpace := DefineWhiteSpace;
  61. end;
  62.  
  63. destructor TMemoScanner.Destroy;
  64. begin
  65.   DiscardWords.Free;
  66.   inherited Destroy;
  67. end;
  68.  
  69. procedure TMemoScanner.DefineDiscardWords(aList: TStrings);
  70. begin
  71.   { There are various methods for implementing the lookup
  72.     list.  A hash table might be faster. }
  73.   with aList do begin
  74.     Add('A');
  75.     Add('ALL');
  76.     Add('AN');
  77.     Add('AND');
  78.     Add('ARE');
  79.     Add('AS');
  80.     Add('BY');
  81.     Add('DO');
  82.     Add('I');
  83.     Add('IN');
  84.     Add('NOT');
  85.     Add('OF');
  86.     Add('THE');
  87.     Add('THEN');
  88.     Add('TO');
  89.     Add('WITH');
  90.   end;
  91. end;
  92.  
  93. function TMemoScanner.DefinePunctuation: string;
  94. begin
  95.   { we specifically omit the hyphen and apostrophe }
  96.   Result := '~`!@#$%^&*()+={}[]|\:;"<>,.?/';
  97. end;
  98.  
  99. function TMemoScanner.DefineWhiteSpace: string;
  100. begin
  101.   Result := #32#8#9#13#10;
  102. end;
  103.  
  104. function TMemoScanner.GetKeyword(aIndex: Integer): string;
  105. begin
  106.   Result := FKeywords[aIndex];
  107. end;
  108.  
  109. function TMemoScanner.GetKeywordCount: Integer;
  110. begin
  111.   Result := FKeywords.Count;
  112. end;
  113.  
  114. procedure TMemoScanner.KeywordFound(aKeyword: string; aWordOffset: Integer);
  115. begin
  116.   FKeywords.Add(aKeyword);
  117. end;
  118.  
  119. procedure TMemoScanner.Scan;
  120. var
  121.   Ch: Char;
  122.   Keyword: string;
  123.   I: Integer;
  124.   BufLen: Integer;
  125.   WordOffset: Integer;
  126.   procedure AddKeyword;
  127.   begin
  128.     if Length(Keyword) <> 0 then begin
  129.       Inc(WordOffset);  { count words in text }
  130.       if DiscardWords.IndexOf(Keyword) = -1 then
  131.         KeywordFound(Keyword, WordOffset);
  132.       Keyword := '';
  133.     end;
  134.   end;
  135. begin
  136.   FKeywords.Clear;
  137.   Keyword := '';
  138.   Position := 0;
  139.   WordOffset := -1;
  140.   while Position < Size do begin
  141.     BufLen := Read(Buffer, SizeOf(Buffer));
  142.     for I := 1 to BufLen do begin
  143.       Ch := UpCase(Buffer[I]);
  144.       { Is it a keyword delimiter? }
  145.       if Pos(Ch, WhiteSpace + Punctuation) <> 0 then
  146.         AddKeyword
  147.       else   {accumulate current keyword}
  148.         Keyword := Keyword + Ch;
  149.     end;
  150.   end;
  151.   AddKeyword;
  152. end;
  153.  
  154. { TMemoScannerExt }
  155.  
  156. constructor TMemoScannerExt.Create(aField: TBLOBField);
  157. begin
  158.   inherited Create(aField);
  159.   FKeywords.Duplicates := dupAccept;
  160. end;
  161.  
  162. procedure TMemoScannerExt.DefineDiscardWords(aList: TStrings);
  163. begin
  164.   { no discard words }
  165. end;
  166.  
  167. function TMemoScannerExt.GetWordOffset(aIndex: Integer): Integer;
  168. begin
  169.   Result := Integer(FKeywords.Objects[aIndex]);
  170. end;
  171.  
  172. procedure TMemoScannerExt.KeywordFound(aKeyword: string; aWordOffset: Integer);
  173. begin
  174.   FKeywords.AddObject(aKeyword, Pointer(aWordOffset));
  175. end;
  176.  
  177. end.
  178.  
  179.